VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FileDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Option Explicit
' FileDlg v1.00 May 1999 contact markb@orionstudios.com
' Class encapsulating Open and SaveAs common dialogs using API
'   See Object Browser for Property/Method descriptions
'
' Note minimum (default) Show Method call to get "Open File" name:-
'    Dim FileName As String
'    With New FileDlg
'        If .Show Then
'            FileName .PathFile
'        End If
'    End With
'=================================================================================
'
' WinAPI Declarations
'
Private Const MAX_PATH = 260
Private Const OFN_EXPLORER = &H80000
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_ENABLEHOOK = &H20 ' With NULL lpfnHook, dialog positions nicely
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const DEFAULT_FLAGS _
                = OFN_EXPLORER _
                Or OFN_LONGNAMES _
                Or OFN_HIDEREADONLY _
                Or OFN_NOCHANGEDIR _
                Or OFN_ENABLEHOOK
Private Const OPEN_FLAGS = DEFAULT_FLAGS Or OFN_FILEMUSTEXIST
Private Const SAVE_FLAGS = DEFAULT_FLAGS Or OFN_OVERWRITEPROMPT

Private Type OPENFILENAME
    lStructSize As Long         ' <= Len(mOPENFILENAME)
    hWndOwner As Long           ' <= Owner
    hInstance As Long           ' not used here
    lpstrFilter As String       ' <= BuildFilterString
    lpstrCustomFilter As String ' not used here
    nMaxCustFilter As Long      ' not used here
    nFilterIndex As Long        ' defaults to 1 (first filter)
    lpstrFile As String         ' <= DefaultFileName padded to MAX_PATH, PathFile =>
    nMaxFile As Long            ' <= length of lpstrFile
    lpstrFileTitle As String    ' <= MAX_PATH space reserved, FileTitle =>
    nMaxFileTitle As Long       ' <= length of lpstrFileTitle
    lpstrDefaultDir As String   ' <= DefaultDir (defaults to App.Path)
    lpstrTitle As String        ' <= Title (dialog caption)
    Flags As Long               ' <= OPEN_FLAGS or SAVE_FLAGS constructed constants
    nFileOffset As Integer      ' => position of FileNameOnly in lpstrFile)
    nFileExtension As Integer   ' => position of FileExtOnly in lpstrFile)
    lpstrDefExt As String       ' <= DefaultFileExt
    lCustData As Long           ' not used here
    lpfnHook As Long            ' not used here (see Const OFN_ENABLEHOOK)
    lpTemplateName As String    ' not used here
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
'
' Module-level variables
'
Private mOPENFILENAME As OPENFILENAME
Private mFilters As VBA.Collection
'
' Local variables to hold property values
'
Private mvarOwner As Long
Private mvarDefaultDir As String
Private mvarDefaultFileName As String
Private mvarDefaultFileExt As String
Private mvarTitle As String
Private mvarPathFile As String
Private mvarPath As String
Private mvarFileName As String
Private mvarFileNameOnly As String
Private mvarFileExtOnly As String
Private mvarFileTitle As String
Private mvarPathFileShort As String ' relevant to OpenDialog only
'
' Enumerations
'
Public Enum DialogType
    OpenDialog
    SaveAsDialog
End Enum
'
' Write-only Properties
'
Public Property Let Owner(ByVal vData As Long)
Attribute Owner.VB_Description = "Window handle of calling form.  (e.g., Form1.hWnd)"
    mvarOwner = vData
End Property

Public Property Let DefaultDir(ByVal vData As String)
Attribute DefaultDir.VB_Description = "Initial file directory. Defaults to application path."
    mvarDefaultDir = vData
End Property

Public Property Let DefaultFileName(ByVal vData As String)
Attribute DefaultFileName.VB_Description = "Filename used to initialize the File Name edit control."
    mvarDefaultFileName = vData
End Property

Public Property Let DefaultFileExt(ByVal vData As String)
Attribute DefaultFileExt.VB_Description = "Extension appended to filename if user does not supply one. Only the first 3 characters are appended. A period (.) MUST NOT be included."
    mvarDefaultFileExt = vData
End Property

Public Property Let Title(ByVal vData As String)
Attribute Title.VB_Description = "Window caption for dialog."
    mvarTitle = vData
End Property
'
' Read-only Properties
'

Public Property Get PathFile() As String
Attribute PathFile.VB_Description = "Full Path (WITH FileName)"
    PathFile = mvarPathFile
End Property

Public Property Get Path() As String
Attribute Path.VB_Description = "Path only (WITHOUT filename)."
    Path = mvarPath
End Property

Public Property Get FileName() As String
Attribute FileName.VB_Description = "Filename WITH extension."
    FileName = mvarFileName
End Property

Public Property Get FileNameOnly() As String
Attribute FileNameOnly.VB_Description = "Filename WITHOUT extension."
    FileNameOnly = mvarFileNameOnly
End Property

Public Property Get FileExtOnly() As String
Attribute FileExtOnly.VB_Description = "File extension (does NOT include a period(.)."
    FileExtOnly = mvarFileExtOnly
End Property

Public Property Get FileTitle() As String
Attribute FileTitle.VB_Description = "File title for display purposes only. Reflects user  preferences."
    FileTitle = mvarFileTitle
End Property

Public Property Get PathFileShort() As String
Attribute PathFileShort.VB_Description = "Short verion of PathFile (including 8.3 style filename)."
    PathFileShort = mvarPathFileShort
End Property
'
' Methods
'
Public Function Show(Optional DlgType As DialogType = OpenDialog) As Boolean
Attribute Show.VB_Description = "Show modal dialog for ""Openf file"" or ""Save file"" (see dlgtype enumeration). Returns True if a file name available."
Attribute Show.VB_UserMemId = 0
    
    On Error GoTo Show_Error
    
    Dim Result As Boolean    ' default function result = false
    Dim boolResult As Long
    Dim lngResult As Long
    Dim strShortName As String
    Dim lngFilePos As Long
    
    With mOPENFILENAME
        .lStructSize = Len(mOPENFILENAME)
        .hWndOwner = mvarOwner
        .lpstrFilter = BuildFilterString
        .lpstrFile = mvarDefaultFileName & String$(MAX_PATH - Len(mvarDefaultFileName), vbNullChar)
        .nMaxFile = Len(.lpstrFile)
        .lpstrTitle = mvarTitle
        .lpstrFileTitle = Space$(MAX_PATH)
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrDefaultDir = mvarDefaultDir
        .lpstrDefExt = mvarDefaultFileExt
    End With
    
    Select Case DlgType
        Case OpenDialog
            mOPENFILENAME.Flags = OPEN_FLAGS
            boolResult = GetOpenFileName(mOPENFILENAME)
        Case SaveAsDialog
            mOPENFILENAME.Flags = SAVE_FLAGS
            boolResult = GetSaveFileName(mOPENFILENAME)
    End Select
    
    If boolResult Then
        With mOPENFILENAME
            mvarPathFile = TrimStr(.lpstrFile)
            mvarPath = Left$(mvarPathFile, .nFileOffset - 1)
            lngFilePos = .nFileOffset + 1
            mvarFileName = Mid$(mvarPathFile, lngFilePos)
            mvarFileNameOnly = Mid$(mvarPathFile, lngFilePos, .nFileExtension - lngFilePos)
            mvarFileExtOnly = Mid$(mvarPathFile, .nFileExtension + 1)
            mvarFileTitle = TrimStr(.lpstrFileTitle)
        End With
        strShortName = Space$(MAX_PATH)
        lngResult = GetShortPathName(mvarPathFile, strShortName, Len(strShortName))
        If lngResult Then
            mvarPathFileShort = Left$(strShortName, lngResult)
        End If
        Result = True
    End If
  
Show_Exit:
    Show = Result
    Exit Function
    
Show_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "FileDlg.Show"
    Resume Show_Exit
    
End Function
'
' Local functions
'

Private Function BuildFilterString() As String
'
' See WinAPI OPENFILENAME.lpstrFilter for required format
'
    On Error GoTo BuildFilterString_Error

    Dim Result As String
    Dim strFilter As Variant
    Dim strFilters As String
    Dim varFilter() As String
    
    For Each strFilter In mFilters
        varFilter = Split(strFilter, ":")
        strFilters = strFilters & Join(varFilter, vbNullChar) & vbNullChar
    Next strFilter
    
BuildFilterString_Exit:
    strFilters = strFilters & vbNullChar
    BuildFilterString = strFilters
    Exit Function
    
BuildFilterString_Error:
    Resume BuildFilterString_Exit

End Function

Public Sub AddFilter(ByVal FilterPair As String)
Attribute AddFilter.VB_Description = "Adds a file filter in the format <description>:<pattern> e.g., ""Word Documents (*.doc;*.rtf):*.doc;*.rtf"""
    mFilters.Add FilterPair
End Sub

Private Function TrimStr(Value As String) As String
    TrimStr = Left$(Value, lstrlen(Value))
End Function

Private Sub Class_Initialize()
    mvarDefaultDir = App.Path
    Set mFilters = New VBA.Collection
End Sub

Private Sub Class_Terminate()
    Set mFilters = Nothing
End Sub
